home *** CD-ROM | disk | FTP | other *** search
/ Maximum CD 2009 December / maximum-cd-2009-12.iso / DiscContents / gimp-2.7.0-i686-setup.exe / {app} / share / gimp / 2.0 / scripts / weave.scm < prev    next >
Encoding:
GIMP Script-Fu Script  |  2009-08-19  |  14.6 KB  |  411 lines
  1. ; GIMP - The GNU Image Manipulation Program
  2. ; Copyright (C) 1995 Spencer Kimball and Peter Mattis
  3. ;
  4. ; Weave script --- make an image look as if it were woven
  5. ; Copyright (C) 1997 Federico Mena Quintero
  6. ; federico@nuclecu.unam.mx
  7. ;
  8. ; This program is free software: you can redistribute it and/or modify
  9. ; it under the terms of the GNU General Public License as published by
  10. ; the Free Software Foundation; either version 3 of the License, or
  11. ; (at your option) any later version.
  12. ;
  13. ; This program is distributed in the hope that it will be useful,
  14. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ; GNU General Public License for more details.
  17. ;
  18. ; You should have received a copy of the GNU General Public License
  19. ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20.  
  21.  
  22. ; Copies the specified rectangle from/to the specified drawable
  23.  
  24. (define (copy-rectangle img
  25.                         drawable
  26.                         x1
  27.                         y1
  28.                         width
  29.                         height
  30.                         dest-x
  31.                         dest-y)
  32.   (gimp-rect-select img x1 y1 width height CHANNEL-OP-REPLACE FALSE 0)
  33.   (gimp-edit-copy drawable)
  34.   (let ((floating-sel (car (gimp-edit-paste drawable FALSE))))
  35.     (gimp-layer-set-offsets floating-sel dest-x dest-y)
  36.     (gimp-floating-sel-anchor floating-sel))
  37.   (gimp-selection-none img))
  38.  
  39. ; Creates a single weaving tile
  40.  
  41. (define (create-weave-tile ribbon-width
  42.                            ribbon-spacing
  43.                            shadow-darkness
  44.                            shadow-depth)
  45.   (let* ((tile-size (+ (* 2 ribbon-width) (* 2 ribbon-spacing)))
  46.          (darkness (* 255 (/ (- 100 shadow-darkness) 100)))
  47.          (img (car (gimp-image-new tile-size tile-size RGB)))
  48.          (drawable (car (gimp-layer-new img tile-size tile-size RGB-IMAGE
  49.                                         "Weave tile" 100 NORMAL-MODE))))
  50.     (gimp-image-undo-disable img)
  51.     (gimp-image-add-layer img drawable 0)
  52.  
  53.     (gimp-context-set-background '(0 0 0))
  54.     (gimp-edit-fill drawable BACKGROUND-FILL)
  55.  
  56.     ; Create main horizontal ribbon
  57.  
  58.     (gimp-context-set-foreground '(255 255 255))
  59.     (gimp-context-set-background (list darkness darkness darkness))
  60.  
  61.     (gimp-rect-select img
  62.                       0
  63.                       ribbon-spacing
  64.                       (+ (* 2 ribbon-spacing) ribbon-width)
  65.                       ribbon-width
  66.                       CHANNEL-OP-REPLACE
  67.                       FALSE
  68.                       0)
  69.  
  70.     (gimp-edit-blend drawable FG-BG-RGB-MODE NORMAL-MODE
  71.                      GRADIENT-BILINEAR 100 (- 100 shadow-depth) REPEAT-NONE FALSE
  72.                      FALSE 0 0 TRUE
  73.                      (/ (+ (* 2 ribbon-spacing) ribbon-width -1) 2) 0 0 0)
  74.  
  75.     ; Create main vertical ribbon
  76.  
  77.     (gimp-rect-select img
  78.                       (+ (* 2 ribbon-spacing) ribbon-width)
  79.                       0
  80.                       ribbon-width
  81.                       (+ (* 2 ribbon-spacing) ribbon-width)
  82.                       CHANNEL-OP-REPLACE
  83.                       FALSE
  84.                       0)
  85.  
  86.     (gimp-edit-blend drawable FG-BG-RGB-MODE NORMAL-MODE
  87.                      GRADIENT-BILINEAR 100 (- 100 shadow-depth) REPEAT-NONE FALSE
  88.                      FALSE 0 0 TRUE
  89.                      0 (/ (+ (* 2 ribbon-spacing) ribbon-width -1) 2) 0 0)
  90.  
  91.     ; Create the secondary horizontal ribbon
  92.  
  93.     (copy-rectangle img
  94.                     drawable
  95.                     0
  96.                     ribbon-spacing
  97.                     (+ ribbon-width ribbon-spacing)
  98.                     ribbon-width
  99.                     (+ ribbon-width ribbon-spacing)
  100.                     (+ (* 2 ribbon-spacing) ribbon-width))
  101.  
  102.     (copy-rectangle img
  103.                     drawable
  104.                     (+ ribbon-width ribbon-spacing)
  105.                     ribbon-spacing
  106.                     ribbon-spacing
  107.                     ribbon-width
  108.                     0
  109.                     (+ (* 2 ribbon-spacing) ribbon-width))
  110.  
  111.     ; Create the secondary vertical ribbon
  112.  
  113.     (copy-rectangle img
  114.                     drawable
  115.                     (+ (* 2 ribbon-spacing) ribbon-width)
  116.                     0
  117.                     ribbon-width
  118.                     (+ ribbon-width ribbon-spacing)
  119.                     ribbon-spacing
  120.                     (+ ribbon-width ribbon-spacing))
  121.  
  122.     (copy-rectangle img
  123.                     drawable
  124.                     (+ (* 2 ribbon-spacing) ribbon-width)
  125.                     (+ ribbon-width ribbon-spacing)
  126.                     ribbon-width
  127.                     ribbon-spacing
  128.                     ribbon-spacing
  129.                     0)
  130.  
  131.     ; Done
  132.  
  133.     (gimp-image-undo-enable img)
  134.  
  135.     (list img drawable)))
  136.  
  137. ; Creates a complete weaving mask
  138.  
  139. (define (create-weave width
  140.                       height
  141.                       ribbon-width
  142.                       ribbon-spacing
  143.                       shadow-darkness
  144.                       shadow-depth)
  145.   (let* ((tile (create-weave-tile ribbon-width ribbon-spacing shadow-darkness
  146.                                   shadow-depth))
  147.          (tile-img (car tile))
  148.          (tile-layer (cadr tile))
  149.           (weaving (plug-in-tile RUN-NONINTERACTIVE tile-img tile-layer width height TRUE)))
  150.     (gimp-image-delete tile-img)
  151.     weaving))
  152.  
  153. ; Creates a single tile for masking
  154.  
  155. (define (create-mask-tile ribbon-width
  156.                           ribbon-spacing
  157.                           r1-x1
  158.                           r1-y1
  159.                           r1-width
  160.                           r1-height
  161.                           r2-x1
  162.                           r2-y1
  163.                           r2-width
  164.                           r2-height
  165.                           r3-x1
  166.                           r3-y1
  167.                           r3-width
  168.                           r3-height)
  169.   (let* ((tile-size (+ (* 2 ribbon-width) (* 2 ribbon-spacing)))
  170.          (img (car (gimp-image-new tile-size tile-size RGB)))
  171.          (drawable (car (gimp-layer-new img tile-size tile-size RGB-IMAGE
  172.                                         "Mask" 100 NORMAL-MODE))))
  173.     (gimp-image-undo-disable img)
  174.     (gimp-image-add-layer img drawable 0)
  175.  
  176.     (gimp-context-set-background '(0 0 0))
  177.     (gimp-edit-fill drawable BACKGROUND-FILL)
  178.  
  179.     (gimp-rect-select img r1-x1 r1-y1 r1-width r1-height CHANNEL-OP-REPLACE FALSE 0)
  180.     (gimp-rect-select img r2-x1 r2-y1 r2-width r2-height CHANNEL-OP-ADD FALSE 0)
  181.     (gimp-rect-select img r3-x1 r3-y1 r3-width r3-height CHANNEL-OP-ADD FALSE 0)
  182.  
  183.     (gimp-context-set-background '(255 255 255))
  184.     (gimp-edit-fill drawable BACKGROUND-FILL)
  185.     (gimp-selection-none img)
  186.  
  187.     (gimp-image-undo-enable img)
  188.  
  189.     (list img drawable)))
  190.  
  191. ; Creates a complete mask image
  192.  
  193. (define (create-mask final-width
  194.                      final-height
  195.                      ribbon-width
  196.                      ribbon-spacing
  197.                      r1-x1
  198.                      r1-y1
  199.                      r1-width
  200.                      r1-height
  201.                      r2-x1
  202.                      r2-y1
  203.                      r2-width
  204.                      r2-height
  205.                      r3-x1
  206.                      r3-y1
  207.                      r3-width
  208.                      r3-height)
  209.   (let* ((tile (create-mask-tile ribbon-width ribbon-spacing
  210.                                  r1-x1 r1-y1 r1-width r1-height
  211.                                  r2-x1 r2-y1 r2-width r2-height
  212.                                  r3-x1 r3-y1 r3-width r3-height))
  213.          (tile-img (car tile))
  214.          (tile-layer (cadr tile))
  215.          (mask (plug-in-tile RUN-NONINTERACTIVE tile-img tile-layer final-width final-height
  216.                              TRUE)))
  217.     (gimp-image-delete tile-img)
  218.     mask))
  219.  
  220. ; Creates the mask for horizontal ribbons
  221.  
  222. (define (create-horizontal-mask ribbon-width
  223.                                 ribbon-spacing
  224.                                 final-width
  225.                                 final-height)
  226.   (create-mask final-width
  227.                final-height
  228.                ribbon-width
  229.                ribbon-spacing
  230.                0
  231.                ribbon-spacing
  232.                (+ (* 2 ribbon-spacing) ribbon-width)
  233.                ribbon-width
  234.                0
  235.                (+ (* 2 ribbon-spacing) ribbon-width)
  236.                ribbon-spacing
  237.                ribbon-width
  238.                (+ ribbon-width ribbon-spacing)
  239.                (+ (* 2 ribbon-spacing) ribbon-width)
  240.                (+ ribbon-width ribbon-spacing)
  241.                ribbon-width))
  242.  
  243. ; Creates the mask for vertical ribbons
  244.  
  245. (define (create-vertical-mask ribbon-width
  246.                               ribbon-spacing
  247.                               final-width
  248.                               final-height)
  249.   (create-mask final-width
  250.                final-height
  251.                ribbon-width
  252.                ribbon-spacing
  253.                (+ (* 2 ribbon-spacing) ribbon-width)
  254.                0
  255.                ribbon-width
  256.                (+ (* 2 ribbon-spacing) ribbon-width)
  257.                ribbon-spacing
  258.                0
  259.                ribbon-width
  260.                ribbon-spacing
  261.                ribbon-spacing
  262.                (+ ribbon-width ribbon-spacing)
  263.                ribbon-width
  264.                (+ ribbon-width ribbon-spacing)))
  265.  
  266. ; Adds a threads layer at a certain orientation to the specified image
  267.  
  268. (define (create-threads-layer img
  269.                               width
  270.                               height
  271.                               length
  272.                               density
  273.                               orientation)
  274.   (let* ((drawable (car (gimp-layer-new img width height RGBA-IMAGE
  275.                                         "Threads" 100 NORMAL-MODE)))
  276.          (dense (/ density 100.0)))
  277.     (gimp-image-add-layer img drawable -1)
  278.     (gimp-context-set-background '(255 255 255))
  279.     (gimp-edit-fill drawable BACKGROUND-FILL)
  280.     (plug-in-noisify RUN-NONINTERACTIVE img drawable FALSE dense dense dense dense)
  281.     (plug-in-c-astretch RUN-NONINTERACTIVE img drawable)
  282.     (cond ((eq? orientation 'horizontal)
  283.            (plug-in-gauss-rle RUN-NONINTERACTIVE img drawable length TRUE FALSE))
  284.           ((eq? orientation 'vertical)
  285.            (plug-in-gauss-rle RUN-NONINTERACTIVE img drawable length FALSE TRUE)))
  286.     (plug-in-c-astretch RUN-NONINTERACTIVE img drawable)
  287.     drawable))
  288.  
  289. (define (create-complete-weave width
  290.                                height
  291.                                ribbon-width
  292.                                ribbon-spacing
  293.                                shadow-darkness
  294.                                shadow-depth
  295.                                thread-length
  296.                                thread-density
  297.                                thread-intensity)
  298.   (let* ((weave (create-weave width height ribbon-width ribbon-spacing
  299.                               shadow-darkness shadow-depth))
  300.          (w-img (car weave))
  301.          (w-layer (cadr weave))
  302.  
  303.          (h-layer (create-threads-layer w-img width height thread-length
  304.                                         thread-density 'horizontal))
  305.          (h-mask (car (gimp-layer-create-mask h-layer ADD-WHITE-MASK)))
  306.  
  307.          (v-layer (create-threads-layer w-img width height thread-length
  308.                                         thread-density 'vertical))
  309.          (v-mask (car (gimp-layer-create-mask v-layer ADD-WHITE-MASK)))
  310.  
  311.          (hmask (create-horizontal-mask ribbon-width ribbon-spacing
  312.                                         width height))
  313.          (hm-img (car hmask))
  314.          (hm-layer (cadr hmask))
  315.  
  316.          (vmask (create-vertical-mask ribbon-width ribbon-spacing width height))
  317.          (vm-img (car vmask))
  318.          (vm-layer (cadr vmask)))
  319.  
  320.     (gimp-layer-add-mask h-layer h-mask)
  321.     (gimp-selection-all hm-img)
  322.     (gimp-edit-copy hm-layer)
  323.     (gimp-image-delete hm-img)
  324.     (gimp-floating-sel-anchor (car (gimp-edit-paste h-mask FALSE)))
  325.     (gimp-layer-set-opacity h-layer thread-intensity)
  326.     (gimp-layer-set-mode h-layer MULTIPLY-MODE)
  327.  
  328.     (gimp-layer-add-mask v-layer v-mask)
  329.     (gimp-selection-all vm-img)
  330.     (gimp-edit-copy vm-layer)
  331.     (gimp-image-delete vm-img)
  332.     (gimp-floating-sel-anchor (car (gimp-edit-paste v-mask FALSE)))
  333.     (gimp-layer-set-opacity v-layer thread-intensity)
  334.     (gimp-layer-set-mode v-layer MULTIPLY-MODE)
  335.  
  336.     ; Uncomment this if you want to keep the weaving mask image
  337.     ; (gimp-display-new (car (gimp-image-duplicate w-img)))
  338.  
  339.     (list w-img
  340.           (car (gimp-image-flatten w-img)))))
  341.  
  342. ; The main weave function
  343.  
  344. (define (script-fu-weave img
  345.                          drawable
  346.                          ribbon-width
  347.                          ribbon-spacing
  348.                          shadow-darkness
  349.                          shadow-depth
  350.                          thread-length
  351.                          thread-density
  352.                          thread-intensity)
  353.   (let* (
  354.         (d-img (car (gimp-drawable-get-image drawable)))
  355.         (d-width (car (gimp-drawable-width drawable)))
  356.         (d-height (car (gimp-drawable-height drawable)))
  357.         (d-offsets (gimp-drawable-offsets drawable))
  358.  
  359.         (weaving (create-complete-weave d-width
  360.                                         d-height
  361.                                         ribbon-width
  362.                                         ribbon-spacing
  363.                                         shadow-darkness
  364.                                         shadow-depth
  365.                                         thread-length
  366.                                         thread-density
  367.                                         thread-intensity))
  368.         (w-img (car weaving))
  369.         (w-layer (cadr weaving))
  370.         )
  371.  
  372.     (gimp-context-push)
  373.  
  374.     (gimp-selection-all w-img)
  375.     (gimp-edit-copy w-layer)
  376.     (gimp-image-delete w-img)
  377.     (let ((floating-sel (car (gimp-edit-paste drawable FALSE))))
  378.       (gimp-layer-set-offsets floating-sel
  379.                               (car d-offsets)
  380.                               (cadr d-offsets))
  381.       (gimp-layer-set-mode floating-sel MULTIPLY-MODE)
  382.       (gimp-floating-sel-to-layer floating-sel)
  383.     )
  384.  
  385.     (gimp-displays-flush)
  386.  
  387.     (gimp-context-pop)
  388.   )
  389. )
  390.  
  391. (script-fu-register "script-fu-weave"
  392.   _"_Weave..."
  393.   _"Create a new layer filled with a weave effect to be used as an overlay or bump map"
  394.   "Federico Mena Quintero"
  395.   "Federico Mena Quintero"
  396.   "June 1997"
  397.   "RGB* GRAY*"
  398.   SF-IMAGE       "Image to Weave"    0
  399.   SF-DRAWABLE    "Drawable to Weave" 0
  400.   SF-ADJUSTMENT _"Ribbon width"     '(30  0 256 1 10 1 1)
  401.   SF-ADJUSTMENT _"Ribbon spacing"   '(10  0 256 1 10 1 1)
  402.   SF-ADJUSTMENT _"Shadow darkness"  '(75  0 100 1 10 1 1)
  403.   SF-ADJUSTMENT _"Shadow depth"     '(75  0 100 1 10 1 1)
  404.   SF-ADJUSTMENT _"Thread length"    '(200 0 256 1 10 1 1)
  405.   SF-ADJUSTMENT _"Thread density"   '(50  0 100 1 10 1 1)
  406.   SF-ADJUSTMENT _"Thread intensity" '(100 0 100 1 10 1 1)
  407. )
  408.  
  409. (script-fu-menu-register "script-fu-weave"
  410.                          "<Image>/Filters/Artistic")
  411.